home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 025a / gsdb25.zip / GS_WINDW.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-03  |  8KB  |  284 lines
  1. UNIT GS_Windw;
  2.  
  3. {-----------------------------------------------------------------------------
  4.                               Window Handler
  5.  
  6.        GS_WINDW Copyright (c)  Richard F. Griffin
  7.  
  8.        15 November 1990
  9.        07 July 1991
  10.  
  11.        102 Molded Stone Pl
  12.        Warner Robins, GA  31088
  13.  
  14.        -------------------------------------------------------------
  15.        This unit handles creation of screen windows.
  16.  
  17.                    SHAREWARE  -- COMMERCIAL USE RESTRICTED
  18.  
  19.    Changes:
  20.              1 Apr 91  :  Inserted checks for monochrome monitors to avoid
  21.                           screen problems if the program attempts to set
  22.                           colors.  Changes are in GS_Wind_SetColors and
  23.                           InitWin.  The problem identification and fix were
  24.                           provided by John Haluska, El Segundo CA,
  25.                           CIS 74000,1106.
  26.  
  27.              7 Jul 91  :  Renamed from GS_Wind to GS_Windw to ensure all
  28.                           references to windows routines are preprocessed
  29.                           by GS_Winfc.  This will allow use of another
  30.                           windows handler instead of GS_Windw by changing
  31.                           the procedure calls and uses statement in GS_Winfc.
  32.  
  33. ------------------------------------------------------------------------------}
  34.  
  35. INTERFACE
  36.  
  37. USES
  38.    Crt,
  39.    Dos,
  40.    GS_Scrn;
  41.  
  42. Type
  43.    GS_Wind_Str80  =  string[80];
  44.  
  45.    GS_Wind_Pntr   =  ^GS_Wind_Objt;
  46.  
  47.    GS_Wind_Objt   = Object
  48.                        x1,
  49.                        y1,
  50.                        x2,
  51.                        y2      :  integer;  {Window size}
  52.                        fg,                  {Foreground color}
  53.                        bg,                  {Background color}
  54.                        tx,                  {Text color}
  55.                        bgh,                 {Inverted background color}
  56.                        txh     :  byte;     {Inverted text color}
  57.                        CurX,                {Last X position when new window}
  58.                        CurY    :  integer;  {Last Y position when new window}
  59.                        dobox   :  boolean;  {Flag to draw a box option}
  60.                        boxname :  GS_Wind_Str80;
  61.                                             {Name for a box when drawn}
  62.                        copywin :  boolean;  {Flag to save old screen area}
  63.                                             {and restore when released}
  64.                        winpntr :  pointer;  {Storage for old screen area}
  65.                        lastwin :  GS_Wind_Pntr;
  66.                                             {Pointer to last window object}
  67.                        procedure MakBox;
  68.                        procedure InitWin (x1w,y1w,x2w,y2w : integer;
  69.                                           txw,bgw,fgw,txx,bgx : integer;
  70.                                           dbox : boolean;
  71.                                           bname : GS_Wind_Str80;
  72.                                           cpywin : boolean);
  73.                        procedure SetWin;
  74.                        procedure RelWin;
  75.                     end;
  76.  
  77. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  78. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  79. Procedure GS_Wind_SetNmMode;
  80. Procedure GS_Wind_SetFgMode;
  81. Procedure GS_Wind_SetIvMode;
  82. Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
  83.  
  84. implementation
  85.  
  86.  
  87. Var
  88.    win     :  GS_Wind_Objt;
  89.    Win_Ptr :  ^GS_Wind_Objt;
  90.    ok_win  :  boolean;
  91.    i       :  integer;
  92.  
  93. Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
  94. begin
  95.    with Win_Ptr^ do
  96.    begin
  97.       txw := tx;
  98.       bgw := bg;
  99.       fgw := fg;
  100.       txx := txh;
  101.       bgx := bgh;
  102.    end;
  103. end;
  104.  
  105. Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
  106. begin
  107.    with Win_Ptr^ do
  108.    if GS_Scrn_Mode <> Mono then
  109.    begin
  110.       tx  := txw;
  111.       bg  := bgw;
  112.       fg  := fgw;
  113.       txh := txx;
  114.       bgh := bgx;
  115.    end;
  116. end;
  117.  
  118. Procedure GS_Wind_SetNmMode;
  119. begin
  120.    with Win_Ptr^ do
  121.    begin
  122.       TextColor(tx);
  123.       TextBackground(bg);
  124.    end;
  125. end;
  126.  
  127. Procedure GS_Wind_SetFgMode;
  128. begin
  129.    with Win_Ptr^ do
  130.    begin
  131.       TextColor(fg);
  132.       TextBackground(bg);
  133.    end;
  134. end;
  135.  
  136. Procedure GS_Wind_SetIvMode;
  137. begin
  138.    with Win_Ptr^ do
  139.    begin
  140.       TextColor(txh);
  141.       TextBackground(bgh);
  142.    end;
  143. end;
  144.  
  145. Procedure GS_Wind_GetWinSize(var wx1,wy1,wx2,wy2 : integer);
  146. begin
  147.    with Win_Ptr^ do
  148.    begin
  149.       wx1 := x1;
  150.       wy1 := y1;
  151.       wx2 := x2;
  152.       wy2 := y2;
  153.    end;
  154. end;
  155.  
  156. procedure GS_Wind_Objt.MakBox;
  157. var
  158.    wsmin,
  159.    wsmax     : word;
  160.    wscx,
  161.    wscy,
  162.    wsattr    : byte;
  163.    x, q      : integer;
  164.    s         : string;
  165.  
  166. begin
  167.    wsmin := WindMin;
  168.    wsmax := WindMax;
  169.    wsattr := TextAttr;
  170.    wscx := wherex;
  171.    wscy := wherey;
  172.    TextColor(fg);
  173.    window (1,1,80,25);
  174.    FillChar(s[1],80,#205);
  175.    x := succ(x2-x1);
  176.    s[0] := chr(x);
  177.    s[1] := #213;
  178.    if length(boxname) > 0 then
  179.    begin
  180.       if length(boxname) > x-2 then boxname[0] := chr(x-2);
  181.       x := (x-length(boxname)) div 2;
  182.       move(boxname[1],s[x+1],length(boxname));
  183.    end;
  184.    s[length(s)] := #184;
  185.    gotoxy(x1,y1);
  186.    write(s);
  187.    for q := y1+1 to y2-1 do
  188.    begin
  189.       gotoxy(x1,q);
  190.       write(#179);
  191.       gotoxy(x2,q);
  192.       write(#179);
  193.    end;
  194.    gotoxy(x1,y2);
  195.    FillChar(s[1],80,#205);
  196.    s[1] := #212;
  197.    s[0] := chr(pred(length(s)));
  198.    write(s);
  199.    GS_Scrn_Put_Char(x2,y2,#190);
  200.    WindMin := wsmin;
  201.    WindMax := wsmax;
  202.    TextAttr := wsattr;
  203.    gotoxy(wscx,wscy);
  204. end;
  205.  
  206. procedure GS_Wind_Objt.SetWin;
  207. begin
  208.    lastwin := win_ptr;
  209.    win_Ptr := @Self;
  210.    lastwin^.CurX := whereX;
  211.    lastwin^.CurY := wherey;
  212.    if copywin then
  213.       GS_Scrn_Get_Win(x1,y1,x2,y2,winpntr^);
  214.    TextColor(fg);
  215.    TextBackground(bg);
  216.    if dobox then
  217.    begin
  218.       MakBox;
  219.       window(x1+1, y1+1, x2-1, y2-1)
  220.    end else
  221.       window(x1, y1, x2, y2);
  222.    TextColor(tx);
  223.    ClrScr;
  224. end;
  225.  
  226. procedure GS_Wind_Objt.RelWin;
  227. begin
  228.    if copywin then
  229.       GS_Scrn_Put_Win(x1,y1,x2,y2,winpntr^);
  230.    win_Ptr := lastwin;
  231.    TextColor(lastwin^.tx);
  232.    TextBackground(lastwin^.bg);
  233.    if lastwin^.dobox then
  234.    begin
  235.       window(lastwin^.x1+1, lastwin^.y1+1, lastwin^.x2-1, lastwin^.y2-1)
  236.    end else
  237.       window(lastwin^.x1, lastwin^.y1, lastwin^.x2, lastwin^.y2);
  238.    gotoXY(lastwin^.CurX,lastwin^.CurY);
  239. end;
  240.  
  241.  
  242. procedure GS_Wind_Objt.InitWin(x1w,y1w,x2w,y2w : integer;
  243.                                txw,bgw,fgw,txx,bgx : integer;
  244.                                dbox : boolean;
  245.                                bname : GS_Wind_Str80;
  246.                                cpywin : boolean);
  247. var
  248.    i,x,q   :  integer;
  249. begin
  250.    x1 := x1w;
  251.    y1 := y1w;
  252.    x2 := x2w;
  253.    y2 := y2w;
  254.    if GS_Scrn_Mode = Mono then
  255.    begin
  256.       fg := LightGray;
  257.       bg := Black;
  258.       tx := LightGray;
  259.       txh := Black;
  260.       bgh := LightGray;
  261.    end
  262.    else
  263.    begin
  264.       fg := fgw;
  265.       bg := bgw;
  266.       tx := txw;
  267.       txh := txx;
  268.       bgh := bgx;
  269.    end;
  270.    dobox := dbox;
  271.    boxname := bname;
  272.    copywin := cpywin;
  273.    if cpywin then
  274.       GetMem(winpntr,(((x2-x1)+1) * ((y2-y1)+1)) * 2)
  275.    else winpntr := nil;
  276. end;
  277.  
  278. begin
  279.    win.InitWin (1,1,80,25,7,0,7,0,7,FALSE,'',FALSE);
  280.    win_ptr := @win;
  281.    win.SetWin;
  282.    win.lastwin := win_Ptr;
  283. end.
  284.